home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / demos / stars.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-22  |  4KB  |  158 lines
  1. PROGRAM Sterne;
  2.  
  3.  
  4. uses Exec, Graphics, Intuition, Utility;
  5.  
  6. {$I tagutils.inc}
  7.  
  8. CONST   MAX_STERNE = 42;
  9.         MAX_GESCHW = 15;
  10.  
  11. TYPE    Star = packed Record
  12.                  x,y :Integer;
  13.                  msin :Real;
  14.                  mcos :Real;
  15.                  d   :Integer;
  16.                  v   :Integer;
  17.                End;
  18.  
  19. VAR     Scr     :pScreen;
  20.         Win     :pWindow;
  21.         Msg     :pIntuiMessage;
  22.         Ende    :Boolean;
  23.         Stars   :Array[1..MAX_STERNE] of Star;
  24.         factor  :Real;
  25.         col     :Integer;
  26.         dum     :Longint;
  27.  
  28.  
  29. PROCEDURE newStern(num :Integer);
  30.  
  31. BEGIN
  32.   col:=Random(360);
  33.   Stars[num].x := Scr^.Width shr 1;
  34.   Stars[num].y := Scr^.Height shr 1;
  35.   Stars[num].msin := sin(col*factor);
  36.   Stars[num].mcos := cos(col*factor);
  37.   Stars[num].d := 0;
  38.   Stars[num].v := Random(MAX_GESCHW)+2;
  39. END;
  40.  
  41.  
  42. PROCEDURE moveStern(num :Integer);
  43.  
  44. BEGIN
  45.   Stars[num].d:=Stars[num].d+Stars[num].v;
  46.   Stars[num].x:=Round(Stars[num].d*Stars[num].msin)+Scr^.Width shr 1;
  47.   Stars[num].y:=Round(Stars[num].d*Stars[num].mcos)+Scr^.Height shr 1;
  48.   {Inc(Stars[num].v);}
  49. END;
  50.  
  51.  
  52. PROCEDURE drawSterne;
  53.  
  54. BEGIN
  55.   For dum:=1 to MAX_STERNE Do Begin
  56.     If Stars[dum].v=0 Then Begin
  57.       If Random(10)>4 Then
  58.         newStern(dum);
  59.     End Else If Stars[dum].d>Scr^.Width shr 1 Then Begin
  60.       SetAPen(Win^.RPort,0);
  61.       If WritePixel(Win^.RPort,(Stars[dum].x),(Stars[dum].y))=0 Then;
  62.       Stars[dum].v:=0;
  63.     End Else Begin
  64.       SetAPen(Win^.RPort,0);
  65.       If WritePixel(Win^.RPort,(Stars[dum].x),(Stars[dum].y))=0 Then;
  66.       moveStern(dum);
  67.       col:=(Stars[dum].d shl 5) Div Scr^.Height shr 1;
  68.       If col>7 Then
  69.         col:=7;
  70.       SetAPen(Win^.RPort,col);
  71.       If WritePixel(Win^.RPort,(Stars[dum].x),(Stars[dum].y))=0 Then;
  72.     End;
  73.   End;
  74. END;
  75.  
  76.  
  77. PROCEDURE initSterne;
  78.  
  79. BEGIN
  80.   For dum:=1 to MAX_STERNE Do begin
  81.     Stars[dum].x := Scr^.Width shr 1;
  82.     Stars[dum].y := Scr^.Height shr 1;
  83.     Stars[dum].msin := 0.0;
  84.     Stars[dum].mcos := 0.0;
  85.     Stars[dum].d := 0;
  86.     Stars[dum].v := 0;
  87.   end;
  88.   factor:=PI/180;
  89. END;
  90.  
  91.  
  92. PROCEDURE CleanUp(str:string; code : Longint);
  93.  
  94. BEGIN
  95.   If Win<>Nil Then
  96.     CloseWindow(Win);
  97.   If (Scr<>Nil) then CloseScreen(Scr);
  98.   if GfxBase <> nil then CloseLibrary(GfxBase);
  99.   if str <> '' then writeln(str);
  100.   Halt(code);
  101. END;
  102.  
  103.  
  104. PROCEDURE Init;
  105. var
  106.   thetags : array[0..3] of tTagItem;
  107.  
  108. BEGIN
  109.   GfxBase := OpenLibrary(GRAPHICSNAME,0);
  110.   if GfxBase = nil then CleanUp('no graphics.library',20);
  111.  
  112.   Scr:=Nil;  Win:=Nil;
  113.  
  114.   thetags[0] := TagItem(SA_Depth,     3);
  115.   thetags[1] := TagItem(SA_DisplayID, HIRES_KEY);
  116.   thetags[2].ti_Tag := TAG_END;
  117.  
  118.   Scr := OpenScreenTagList(NIL,@thetags);
  119.   If Scr=Nil Then CleanUp('No screen',20);
  120.  
  121.   thetags[0] := TagItem(WA_Flags, WFLG_BORDERLESS);
  122.   thetags[1] := TagItem(WA_IDCMP, IDCMP_MOUSEBUTTONS);
  123.   thetags[2] := TagItem(WA_CustomScreen, Longint(Scr));
  124.   thetags[3].ti_Tag := TAG_DONE;
  125.  
  126.   Win:=OpenWindowTagList(Nil, @thetags);
  127.   If Win=Nil Then CleanUp('No window',20);
  128.  
  129.   initSterne;
  130.  
  131.   SetRGB4(@Scr^.ViewPort, 0, $0,$0,$0);
  132.   SetRGB4(@Scr^.ViewPort, 1, $3,$3,$3);
  133.   SetRGB4(@Scr^.ViewPort, 2, $6,$6,$6);
  134.   SetRGB4(@Scr^.ViewPort, 3, $b,$b,$b);
  135.   SetRGB4(@Scr^.ViewPort, 4, $c,$c,$c);
  136.   SetRGB4(@Scr^.ViewPort, 5, $d,$d,$d);
  137.   SetRGB4(@Scr^.ViewPort, 6, $e,$e,$e);
  138.   SetRGB4(@Scr^.ViewPort, 7, $f,$f,$f);
  139.  
  140. END;
  141.  
  142.  
  143.  
  144. BEGIN
  145.   Init;
  146.   Ende:=false;
  147.   Repeat
  148.     drawSterne;
  149.     Msg:=pIntuiMessage(GetMsg(Win^.UserPort));
  150.     If Msg<>Nil Then Begin
  151.       ReplyMsg(Pointer(Msg));
  152.       Ende:=true;
  153.     End;
  154.   Until Ende;
  155.   CleanUp('',0);
  156. END.
  157.  
  158.